program generate_xcb_bindings;

{$mode objfpc}{$H+}
uses
  Classes, SysUtils, DOM, XMLRead, StrUtils;

const
  INDENT = '  ';

type
  TStringListHelper = class helper for TStringList
    procedure AddIndent(const s: string; level: Integer = 0);
  end;

function NodeIndex(N: TDOMNode): Integer;
var p: TDOMNode;
begin
  Result := 0;
  p := N.PreviousSibling;
  while Assigned(p) do
  begin
    Inc(Result);
    p := p.PreviousSibling;
  end;
end;

procedure TStringListHelper.AddIndent(const s: string; level: Integer = 0);
var
  i: Integer;
  pref: string;
begin
  pref := StringOfChar(' ', level * Length(INDENT));
  Add(pref + s);
end;

{ --- Utility: map XCB types to ctypes --- }
function MapXCBTypeToPascal(const xtype: string): string;
var
  x: string;
begin
  x := Trim(xtype);
  // Normalize common XCB types
  if x = '' then Exit('Pointer');
  if SameText(x, 'CARD8') then Exit('cuint8');
  if SameText(x, 'CARD16') then Exit('cuint16');
  if SameText(x, 'CARD32') then Exit('cuint32');
  if SameText(x, 'CARD64') then Exit('cuint64');
  if SameText(x, 'INT8') then Exit('cint8');
  if SameText(x, 'INT16') then Exit('cint16');
  if SameText(x, 'INT32') then Exit('cint32');
  if SameText(x, 'INT64') then Exit('cint64');
  if SameText(x, 'BYTE') then Exit('cuint8');
  if SameText(x, 'BOOL') then Exit('cuint8');
  if SameText(x, 'void') then Exit('Pointer');
  if SameText(x, 'string') or SameText(x, 'str') or SameText(x, 'STRING') then Exit('PAnsiChar');
  if SameText(x, 'float') then Exit('cfloat');
  if SameText(x, 'double') then Exit('cdouble');
  if SameText(x, 'char') then Exit('cchar');
  
  // X IDs and core types often map to uint32 on 64-bit ABI for xcb (but we keep cuint32)
  if SameText(x, 'Window') or SameText(x, 'Drawable') or SameText(x, 'Atom') or SameText(x, 'Colormap')
    or SameText(x, 'Cursor') or SameText(x, 'VisualID') or SameText(x, 'Time') 
    or SameText(x, 'Pixmap') or SameText(x, 'Region') or SameText(x, 'Rectangle')
    or SameText(x, 'Fence') or SameText(x, 'Crtc') then Exit('cuint32');
  
  // Fallback: if starts with 'CARD' numeric -> cuint32 default
  if StartsText('CARD', UpperCase(x)) then Exit('cuint32');
  if StartsText('INT', UpperCase(x)) then Exit('cint32');

  // If it looks like a custom typedef / xidtype, emit T<Name>
  // sanitize name: replace non-alnum with underscore
  Result := 'T' + StringReplace(x, '.', '_', [rfReplaceAll]);
end;

{ --- Emit safe identifier from xml name --- }
function SafeIdent(const s: string): string;
var
  r: string;
  i: Integer;
  keywords: TStringList;
begin
  r := s;
  // replace non-alnum with underscore
  for i := 1 to Length(r) do
    if not (r[i] in ['0'..'9','A'..'Z','a'..'z','_']) then
      r[i] := '_';
  
  // cannot start with digit
  if (Length(r) > 0) and (r[1] in ['0'..'9']) then
    r := 'N' + r;
    
  // Check for Pascal keywords and prefix with underscore
  keywords := TStringList.Create;
  try
    keywords.CommaText := 'record,type,class,property,function,procedure,begin,end,if,then,else,while,do,for,repeat,until,case,of,var,const,array,set,file,program,unit,uses,interface,implementation,initialization,finalization,label,inline,object,constructor,destructor,inherited,packed,absolute,external,forward,mod,div,not,or,and,xor,shl,shr,asm';
    
    if keywords.IndexOf(LowerCase(r)) >= 0 then
      r := '_' + r;
  finally
    keywords.Free;
  end;
  
  Result := r;
end;

{ --- Write unit header --- }
procedure EmitUnitHeader(sl: TStringList; const unitName: string);
begin
  sl.Add('unit ' + unitName + ';');
  sl.Add('');
  sl.Add('{$mode objfpc}{$H+}');
  sl.Add('');
  sl.Add('interface');
  sl.Add('');
  sl.Add('uses');
  sl.AddIndent('ctypes, xcb;', 1);
  sl.Add('');
end;

{ --- Write unit footer --- }
procedure EmitUnitFooter(sl: TStringList);
begin
  sl.Add('');
  sl.Add('implementation');
  sl.Add('');
  sl.Add('end.');
end;

{ --- Parse enums --- }
procedure ProcessEnums(node: TDOMNode; sl: TStringList);
var
  child, enumNode: TDOMNode;
  enumName: string;
  valueNodes: TDOMNode;
  j: Integer;
  valName, valValue: string;
  attr: TDOMNode;
begin
  child := node.FirstChild;
  while Assigned(child) do
  begin
    if (child.NodeName = 'enum') then
    begin
      enumNode := child;
      attr := enumNode.Attributes.GetNamedItem('name');
      if attr<>nil then
        enumName := attr.NodeValue
      else
        enumName := 'unnamed_enum';

      sl.AddIndent('// enum ' + enumName, 1);
      sl.AddIndent('const', 1);

      valueNodes := enumNode.FirstChild;
      for j := 0 to enumNode.ChildNodes.Count - 1 do
      begin
        if enumNode.ChildNodes[j].NodeName = 'item' then
        begin
          valName := enumNode.ChildNodes[j].Attributes.GetNamedItem('name').NodeValue;

          attr := enumNode.ChildNodes[j].Attributes.GetNamedItem('value');
          if attr<>nil then
            valValue := attr.NodeValue
          else
            valValue := '0';

          sl.AddIndent(Format('%s = %s;', [SafeIdent(enumName + '_' + valName), valValue]), 2);
        end;
      end;
      sl.Add('');
    end;
    child := child.NextSibling;
  end;
end;

{ --- Process typedefs --- }
procedure ProcessTypedefs(node: TDOMNode; sl: TStringList);
var
  i: Integer;
  child: TDOMNode;
  name, toType: string;
begin
  child := node.FirstChild;
  while Assigned(child) do
  begin
    if child.NodeName = 'typedef' then
    begin
      name := child.Attributes.GetNamedItem('newname').NodeValue;
      if child.Attributes.GetNamedItem('oldname') <> nil then
        toType := child.Attributes.GetNamedItem('oldname').NodeValue
      else if child.TextContent <> '' then
        toType := Trim(child.TextContent)
      else
        toType := '';
      sl.AddIndent('// typedef ' + name + ' -> ' + toType, 1);
      if toType <> '' then
        sl.AddIndent(Format('type %s = %s;', [SafeIdent('T' + name), MapXCBTypeToPascal(toType)]), 1)
      else
        sl.AddIndent(Format('type %s = Pointer; // typedef %s (unknown target)', [SafeIdent('T' + name), name]), 1);
      sl.Add('');
    end;
    child := child.NextSibling;
  end;
end;

{ --- Process structs --- }
procedure ProcessStructs(node: TDOMNode; sl: TStringList);
var
  child, structNode, fieldNode: TDOMNode;
  i, j, padBytes: Integer;
  structName, fname, ftype: string;
  attrNode: TDOMNode;
begin
  child := node.FirstChild;
  while Assigned(child) do
  begin
    if SameText(child.NodeName, 'struct') then
    begin
      structNode := child;
      attrNode := structNode.Attributes.GetNamedItem('name');
      if Assigned(attrNode) then
        structName := attrNode.NodeValue
      else
        structName := 'unnamed_struct';

      sl.AddIndent('// struct ' + structName, 1);
      sl.AddIndent('type', 1);
      sl.AddIndent(Format('%s = packed record', [SafeIdent('T' + structName)]), 2);

      for i := 0 to structNode.ChildNodes.Count - 1 do
      begin
        fieldNode := structNode.ChildNodes[i];

        if SameText(fieldNode.NodeName, 'field') then
        begin
          // field name
          if Assigned(fieldNode.Attributes.GetNamedItem('name')) then
            fname := SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue)
          else
            fname := Format('field_%d', [NodeIndex(fieldNode)]);

          // field type (may be absent for list/str)
          if Assigned(fieldNode.Attributes.GetNamedItem('type')) then
            ftype := fieldNode.Attributes.GetNamedItem('type').NodeValue
          else
            ftype := '';

          // handle common varlen/list/str as Pointer with comment
          if (ftype = '') or SameText(ftype, 'list') or SameText(ftype, 'str') or SameText(ftype, 'STRING') then
          begin
            sl.AddIndent(Format('%s: Pointer; // original: %s (node index %d)', [fname, Trim(fieldNode.TextContent), NodeIndex(fieldNode)]), 3);
          end
          else
          begin
            sl.AddIndent(Format('%s: %s;', [fname, MapXCBTypeToPascal(ftype)]), 3);
          end;
        end
        else if SameText(fieldNode.NodeName, 'pad') then
        begin
          // pad element: try to read bytes attr
          if Assigned(fieldNode.Attributes.GetNamedItem('bytes')) then
          begin
            try
              padBytes := StrToInt(fieldNode.Attributes.GetNamedItem('bytes').NodeValue);
              if padBytes > 0 then
                sl.AddIndent(Format('pad_%d: array[0..%d-1] of cuint8; // padding', [NodeIndex(fieldNode), padBytes]), 3)
              else
                sl.AddIndent(Format('pad_%d: cuint8; // pad (0 bytes)', [NodeIndex(fieldNode)]), 3);
            except
              on E: Exception do
                sl.AddIndent(Format('pad_%d: cuint8; // pad (invalid bytes: %s)', [NodeIndex(fieldNode), fieldNode.Attributes.GetNamedItem('bytes').NodeValue]), 3);
            end;
          end
          else
            sl.AddIndent(Format('pad_%d: cuint8; // pad (unspecified bytes)', [NodeIndex(fieldNode)]), 3);
        end
        else if SameText(fieldNode.NodeName, 'doc') then
        begin
          // documentation node — ignore or optionally include as comment
          // sl.AddIndent('// doc: ' + Trim(fieldNode.TextContent), 3);
        end
        else
        begin
          // unknown/special nodes: list, switch, enumRef, etc. — add comment for manual handling
          sl.AddIndent(Format('// %s (node index %d) - manual handling may be required; original: %s', [fieldNode.NodeName, NodeIndex(fieldNode), Trim(fieldNode.TextContent)]), 3);
        end;
      end;

      sl.AddIndent('end;', 2);
      sl.Add('');
    end;

    child := child.NextSibling;
  end;
end;

{ --- Process events/errors (as typedef of record) --- }
procedure ProcessEventsErrors(node: TDOMNode; sl: TStringList; kind: string);
var
  child, enode, fieldNode: TDOMNode;
  name, fname, ftype: string;
  i: Integer;
begin
  child := node.FirstChild;
  while Assigned(child) do
  begin
    if SameText(child.NodeName, kind) then
    begin
      enode := child;
      name := enode.Attributes.GetNamedItem('name').NodeValue;
      sl.AddIndent('// ' + kind + ' ' + name, 1);
      sl.AddIndent('type', 1);
      sl.AddIndent(Format('%s = packed record', [SafeIdent('T' + name)]), 2);
      for i := 0 to enode.ChildNodes.Count - 1 do
      begin
        fieldNode := enode.ChildNodes[i];
        if fieldNode.NodeName = 'field' then
        begin
          fname := SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue);
          if fieldNode.Attributes.GetNamedItem('type') <> nil then
            ftype := fieldNode.Attributes.GetNamedItem('type').NodeValue
          else
            ftype := '';
          if (ftype = '') or SameText(ftype, 'str') or SameText(ftype, 'list') then
            sl.AddIndent(Format('%s: Pointer; // original: %s', [fname, fieldNode.TextContent]), 3)
          else
            sl.AddIndent(Format('%s: %s;', [fname, MapXCBTypeToPascal(ftype)]), 3);
        end;
      end;
      sl.AddIndent('end;', 2);
      sl.Add('');
    end;
    child := child.NextSibling;
  end;
end;

{ --- Process requests (generate opcode const and reply record if present) --- }
procedure ProcessRequests(node: TDOMNode; sl: TStringList);
var
  child, rnode, replyNode, fieldNode: TDOMNode;
  name, opcode: string;
  i, j: Integer;
begin
  child := node.FirstChild;
  while Assigned(child) do
  begin
    if child.NodeName = 'request' then
    begin
      rnode := child;
      name := rnode.Attributes.GetNamedItem('name').NodeValue;
      opcode := '0'; // may be in attribute opcode
      if rnode.Attributes.GetNamedItem('opcode') <> nil then
        opcode := rnode.Attributes.GetNamedItem('opcode').NodeValue;
      sl.AddIndent('// request ' + name, 1);
      sl.AddIndent(Format('const XCB_%s = %s; // opcode', [UpperCase(name), opcode]), 1);
      // reply
      replyNode := nil;
      for i := 0 to rnode.ChildNodes.Count - 1 do
      begin
        if rnode.ChildNodes[i].NodeName = 'reply' then
        begin
          replyNode := rnode.ChildNodes[i];
          Break;
        end;
      end;
      if Assigned(replyNode) then
      begin
        sl.AddIndent('type', 1);
        sl.AddIndent(Format('%sReply = packed record', [SafeIdent('T' + name)]), 2);
        for j := 0 to replyNode.ChildNodes.Count - 1 do
        begin
          fieldNode := replyNode.ChildNodes[j];
          if fieldNode.NodeName = 'field' then
          begin
            if fieldNode.Attributes.GetNamedItem('type') <> nil then
              sl.AddIndent(Format('%s: %s;', [SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue),
                MapXCBTypeToPascal(fieldNode.Attributes.GetNamedItem('type').NodeValue)]), 3)
            else
              sl.AddIndent(Format('%s: Pointer; // varlen/unknown', [SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue)]), 3);
          end;
        end;
        sl.AddIndent('end;', 2);
        sl.Add('');
      end;
    end;
    child := child.NextSibling;
  end;
end;

{ --- Process xid types --- }
procedure ProcessXidTypes(node: TDOMNode; sl: TStringList);
var
  child: TDOMNode;
  name: string;
begin
  child := node.FirstChild;
  while Assigned(child) do
  begin
    if child.NodeName = 'xidtype' then
    begin
      name := child.Attributes.GetNamedItem('name').NodeValue;
      sl.AddIndent('// xidtype ' + name, 1);
      sl.AddIndent(Format('type %s = cuint32;', [SafeIdent('T' + name)]), 1);
      sl.Add('');
    end;
    child := child.NextSibling;
  end;
end;

{ --- Process constants (value) --- }
procedure ProcessValues(node: TDOMNode; sl: TStringList);
var
  child, vnode: TDOMNode;
  name, val: string;
begin
  child := node.FirstChild;
  while Assigned(child) do
  begin
    if child.NodeName = 'value' then
    begin
      vnode := child;
      name := SafeIdent(vnode.Attributes.GetNamedItem('name').NodeValue);
      if vnode.Attributes.GetNamedItem('value') <> nil then
        val := vnode.Attributes.GetNamedItem('value').NodeValue
      else
        val := vnode.TextContent;
      sl.AddIndent(Format('const %s = %s;', [name, val]), 1);
    end;
    child := child.NextSibling;
  end;
  if sl[sl.Count-1] <> '' then sl.Add('');
end;

{ --- Process unions --- }
procedure ProcessUnions(node: TDOMNode; sl: TStringList);
var
  child, unionNode, fieldNode: TDOMNode;
  i: Integer;
  unionName, fname, ftype: string;
begin
  child := node.FirstChild;
  while Assigned(child) do
  begin
    if SameText(child.NodeName, 'union') then
    begin
      unionNode := child;
      unionName := unionNode.Attributes.GetNamedItem('name').NodeValue;

      sl.AddIndent('// union ' + unionName, 1);
      sl.AddIndent('type', 1);
      sl.AddIndent(Format('%s = packed record', [SafeIdent('T' + unionName)]), 2);
      sl.AddIndent('case Integer of', 3);

      for i := 0 to unionNode.ChildNodes.Count - 1 do
      begin
        fieldNode := unionNode.ChildNodes[i];
        if SameText(fieldNode.NodeName, 'field') then
        begin
          fname := SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue);
          if fieldNode.Attributes.GetNamedItem('type') <> nil then
            ftype := MapXCBTypeToPascal(fieldNode.Attributes.GetNamedItem('type').NodeValue)
          else
            ftype := 'Pointer';

          sl.AddIndent(Format('%d: (%s: %s);', [i, fname, ftype]), 4);
        end;
      end;

      sl.AddIndent('end;', 2);
      sl.Add('');
    end;
    child := child.NextSibling;
  end;
end;

{ --- Main: parse a single xml file and emit .pas --- }
procedure ProcessXMLFile(const xmlPath: string; const outDir: string);
var
  doc: TXMLDocument;
  root: TDOMNode;
  unitName, outFile: string;
  sl: TStringList;
  xmlFilename: string;
begin
  WriteLn('Parsing ', xmlPath);
  try
    ReadXMLFile(doc, xmlPath);
  except
    on E: Exception do
    begin
      WriteLn('Error reading XML ', xmlPath, ': ', E.Message);
      Exit;
    end;
  end;
  root := doc.DocumentElement;
  if not Assigned(root) then
  begin
    WriteLn('No document element in ', xmlPath);
    doc.Free;
    Exit;
  end;
  if root.Attributes.GetNamedItem('name') <> nil then
    unitName := root.Attributes.GetNamedItem('name').NodeValue
  else
    unitName := ChangeFileExt(ExtractFileName(xmlPath), '');
  unitName := SafeIdent(LowerCase(unitName)); // use lower-case safe name
  outFile := IncludeTrailingPathDelimiter(outDir) + unitName + '.pas';

  sl := TStringList.Create;
  try
    EmitUnitHeader(sl, unitName);

    // Add short auto-generated comment
    sl.AddIndent('// Auto-generated from ' + ExtractFileName(xmlPath), 1);
    sl.AddIndent('// Pure 1:1 C binding skeleton for FreePascal (packed records, consts).', 1);
    sl.Add('');

    // process common nodes
    ProcessXidTypes(root, sl);
    ProcessTypedefs(root, sl);
    ProcessEnums(root, sl);
    ProcessValues(root, sl);
    ProcessStructs(root, sl);
    ProcessUnions(root, sl); // Add union processing
    ProcessEventsErrors(root, sl, 'event');
    ProcessEventsErrors(root, sl, 'error');
    ProcessRequests(root, sl);

    EmitUnitFooter(sl);

    sl.SaveToFile(outFile);
    WriteLn('Wrote ', outFile);
  finally
    sl.Free;
    doc.Free;
  end;
end;

{ --- Main program entry --- }
var
  i: Integer;
  srcDir, outDir: string;
  sr: TSearchRec;
  found: Integer;
begin
  if ParamCount < 1 then
  begin
    WriteLn('Usage: generate_xcb_bindings <path-to-xcb-proto-xml-dir> [outdir]');
    Halt(1);
  end;
  srcDir := ParamStr(1);
  if ParamCount >= 2 then outDir := ParamStr(2) else outDir := srcDir;

  if not DirectoryExists(srcDir) then
  begin
    WriteLn('Directory not found: ', srcDir);
    Halt(1);
  end;

  // Create output directory if it doesn't exist
  if not DirectoryExists(outDir) then
    CreateDir(outDir);

  // iterate xml files
  found := 0;
  if FindFirst(IncludeTrailingPathDelimiter(srcDir) + '*.xml', faAnyFile, sr) = 0 then
  begin
    repeat
      ProcessXMLFile(IncludeTrailingPathDelimiter(srcDir) + sr.Name, outDir);
      Inc(found);
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;

  if found = 0 then
    WriteLn('No .xml files found in ', srcDir)
  else
    WriteLn('Processed ', found, ' files.');

end.

program generate_xcb_bindings;

{$mode objfpc}{$H+}
uses
  Classes, SysUtils, DOM, XMLRead, StrUtils;

const
  INDENT = '  ';

type
  TStringListHelper = class helper for TStringList
    procedure AddIndent(const s: string; level: Integer = 0);
  end;

function NodeIndex(N: TDOMNode): Integer;
var p: TDOMNode;
begin
  Result := 0;
  p := N.PreviousSibling;
  while Assigned(p) do
  begin
    Inc(Result);
    p := p.PreviousSibling;
  end;
end;

procedure TStringListHelper.AddIndent(const s: string; level: Integer = 0);
var
  i: Integer;
  pref: string;
begin
  pref := StringOfChar(' ', level * Length(INDENT));
  Add(pref + s);
end;

{ --- Utility: map XCB types to ctypes --- }
function MapXCBTypeToPascal(const xtype: string): string;
var
  x: string;
begin
  x := Trim(xtype);
  // Normalize common XCB types
  if x = '' then Exit('Pointer');
  if SameText(x, 'CARD8') then Exit('cuint8');
  if SameText(x, 'CARD16') then Exit('cuint16');
  if SameText(x, 'CARD32') then Exit('cuint32');
  if SameText(x, 'CARD64') then Exit('cuint64');
  if SameText(x, 'INT8') then Exit('cint8');
  if SameText(x, 'INT16') then Exit('cint16');
  if SameText(x, 'INT32') then Exit('cint32');
  if SameText(x, 'INT64') then Exit('cint64');
  if SameText(x, 'BYTE') then Exit('cuint8');
  if SameText(x, 'BOOL') then Exit('cuint8');
  if SameText(x, 'void') then Exit('Pointer');
  if SameText(x, 'string') or SameText(x, 'str') or SameText(x, 'STRING') then Exit('PAnsiChar');
  if SameText(x, 'float') then Exit('cfloat');
  if SameText(x, 'double') then Exit('cdouble');
  if SameText(x, 'char') then Exit('cchar');
  if SameText(x, 'Timestamp') or SameText(x, 'TIMESTAMP') then Exit('cuint32');
  if SameText(x, 'KeyCode') or SameText(x, 'KEYCODE') then Exit('cuint8');
  if SameText(x, 'KeySym') or SameText(x, 'KEYSYM') then Exit('cuint32');
  
  // X IDs and core types often map to uint32 on 64-bit ABI for xcb (but we keep cuint32)
  if SameText(x, 'Window') or SameText(x, 'Drawable') or SameText(x, 'Atom') or SameText(x, 'Colormap')
    or SameText(x, 'Cursor') or SameText(x, 'VisualID') or SameText(x, 'Time') 
    or SameText(x, 'Pixmap') or SameText(x, 'Region') or SameText(x, 'Rectangle')
    or SameText(x, 'Fence') or SameText(x, 'Crtc') or SameText(x, 'Transform')
    or SameText(x, 'Barrier') then Exit('cuint32');
  
  // Fallback: if starts with 'CARD' numeric -> cuint32 default
  if StartsText('CARD', UpperCase(x)) then Exit('cuint32');
  if StartsText('INT', UpperCase(x)) then Exit('cint32');

  // If it looks like a custom typedef / xidtype, emit T<Name>
  // sanitize name: replace non-alnum with underscore
  Result := 'T' + StringReplace(x, '.', '_', [rfReplaceAll]);
end;

{ --- Emit safe identifier from xml name --- }
function SafeIdent(const s: string): string;
var
  r: string;
  i: Integer;
  keywords: TStringList;
begin
  if s = '' then
  begin
    Result := 'unnamed';
    Exit;
  end;
  
  r := s;
  // replace non-alnum with underscore
  for i := 1 to Length(r) do
    if not (r[i] in ['0'..'9','A'..'Z','a'..'z','_']) then
      r[i] := '_';
  
  // cannot start with digit
  if (Length(r) > 0) and (r[1] in ['0'..'9']) then
    r := 'N' + r;
    
  // Check for Pascal keywords and prefix with underscore
  keywords := TStringList.Create;
  try
    keywords.CommaText := 'record,type,class,property,function,procedure,begin,end,if,then,else,while,do,for,repeat,until,case,of,var,const,array,set,file,program,unit,uses,interface,implementation,initialization,finalization,label,inline,object,constructor,destructor,inherited,packed,absolute,external,forward,mod,div,not,or,and,xor,shl,shr,asm';
    
    if keywords.IndexOf(LowerCase(r)) >= 0 then
      r := '_' + r;
  finally
    keywords.Free;
  end;
  
  Result := r;
end;

{ --- Write unit header --- }
procedure EmitUnitHeader(sl: TStringList; const unitName: string);
begin
  sl.Add('unit ' + unitName + ';');
  sl.Add('');
  sl.Add('{$mode objfpc}{$H+}');
  sl.Add('');
  sl.Add('interface');
  sl.Add('');
  sl.Add('uses');
  sl.AddIndent('ctypes, xcb;', 1);
  sl.Add('');
end;

{ --- Write unit footer --- }
procedure EmitUnitFooter(sl: TStringList);
begin
  sl.Add('');
  sl.Add('implementation');
  sl.Add('');
  sl.Add('end.');
end;

{ --- Parse enums --- }
procedure ProcessEnums(node: TDOMNode; sl: TStringList);
var
  child, enumNode: TDOMNode;
  enumName: string;
  j: Integer;
  valName, valValue: string;
  attr: TDOMNode;
  processedEnums: TStringList;
begin
  processedEnums := TStringList.Create;
  try
    processedEnums.Sorted := True;
    processedEnums.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if (child.NodeName = 'enum') then
      begin
        enumNode := child;
        attr := enumNode.Attributes.GetNamedItem('name');
        if attr<>nil then
          enumName := attr.NodeValue
        else
          enumName := 'unnamed_enum';

        // Skip if already processed (avoid duplicates)
        if processedEnums.IndexOf(enumName) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedEnums.Add(enumName);

        sl.AddIndent('// enum ' + enumName, 1);
        sl.AddIndent('const', 1);

        for j := 0 to enumNode.ChildNodes.Count - 1 do
        begin
          if enumNode.ChildNodes[j].NodeName = 'item' then
          begin
            valName := enumNode.ChildNodes[j].Attributes.GetNamedItem('name').NodeValue;

            attr := enumNode.ChildNodes[j].Attributes.GetNamedItem('value');
            if attr<>nil then
              valValue := attr.NodeValue
            else
            begin
              // Try to get value from child text content for bitcase enums
              attr := enumNode.ChildNodes[j].Attributes.GetNamedItem('bit');
              if attr <> nil then
                valValue := IntToStr(1 shl StrToInt(attr.NodeValue))
              else
                valValue := '0';
            end;

            // Handle hex values and expressions
            if Pos('0x', valValue) = 1 then
              valValue := '$' + Copy(valValue, 3, MaxInt)
            else if (Pos('<<', valValue) > 0) or (Pos('+', valValue) > 0) then
            begin
              // Simple expression evaluation for common cases
              if Pos('1<<', valValue) = 1 then
                valValue := IntToStr(1 shl StrToInt(Copy(valValue, 4, MaxInt)))
              else
                valValue := '0'; // Fallback for complex expressions
            end;

            sl.AddIndent(Format('%s = %s;', [SafeIdent(enumName + '_' + valName), valValue]), 2);
          end;
        end;
        sl.Add('');
      end;
      child := child.NextSibling;
    end;
  finally
    processedEnums.Free;
  end;
end;

{ --- Process typedefs --- }
procedure ProcessTypedefs(node: TDOMNode; sl: TStringList);
var
  child: TDOMNode;
  name, toType: string;
  processedTypes: TStringList;
begin
  processedTypes := TStringList.Create;
  try
    processedTypes.Sorted := True;
    processedTypes.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if child.NodeName = 'typedef' then
      begin
        name := child.Attributes.GetNamedItem('newname').NodeValue;
        
        // Skip if already processed
        if processedTypes.IndexOf(name) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedTypes.Add(name);
        
        if child.Attributes.GetNamedItem('oldname') <> nil then
          toType := child.Attributes.GetNamedItem('oldname').NodeValue
        else if child.TextContent <> '' then
          toType := Trim(child.TextContent)
        else
          toType := '';
        sl.AddIndent('// typedef ' + name + ' -> ' + toType, 1);
        if toType <> '' then
          sl.AddIndent(Format('type %s = %s;', [SafeIdent('T' + name), MapXCBTypeToPascal(toType)]), 1)
        else
          sl.AddIndent(Format('type %s = Pointer; // typedef %s (unknown target)', [SafeIdent('T' + name), name]), 1);
        sl.Add('');
      end;
      child := child.NextSibling;
    end;
  finally
    processedTypes.Free;
  end;
end;

{ --- Process structs --- }
procedure ProcessStructs(node: TDOMNode; sl: TStringList);
var
  child, structNode, fieldNode: TDOMNode;
  i, padBytes: Integer;
  structName, fname, ftype: string;
  attrNode: TDOMNode;
  processedStructs: TStringList;
begin
  processedStructs := TStringList.Create;
  try
    processedStructs.Sorted := True;
    processedStructs.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if SameText(child.NodeName, 'struct') then
      begin
        structNode := child;
        attrNode := structNode.Attributes.GetNamedItem('name');
        if Assigned(attrNode) then
          structName := attrNode.NodeValue
        else
          structName := 'unnamed_struct';

        // Skip if already processed
        if processedStructs.IndexOf(structName) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedStructs.Add(structName);

        sl.AddIndent('// struct ' + structName, 1);
        sl.AddIndent('type', 1);
        sl.AddIndent(Format('%s = packed record', [SafeIdent('T' + structName)]), 2);

        for i := 0 to structNode.ChildNodes.Count - 1 do
        begin
          fieldNode := structNode.ChildNodes[i];

          if SameText(fieldNode.NodeName, 'field') then
          begin
            // field name
            if Assigned(fieldNode.Attributes.GetNamedItem('name')) then
              fname := SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue)
            else
              fname := Format('field_%d', [NodeIndex(fieldNode)]);

            // field type (may be absent for list/str)
            if Assigned(fieldNode.Attributes.GetNamedItem('type')) then
              ftype := fieldNode.Attributes.GetNamedItem('type').NodeValue
            else
              ftype := '';

            // handle common varlen/list/str as Pointer with comment
            if (ftype = '') or SameText(ftype, 'list') or SameText(ftype, 'str') or SameText(ftype, 'STRING') then
            begin
              sl.AddIndent(Format('%s: Pointer; // original: %s (node index %d)', [fname, Trim(fieldNode.TextContent), NodeIndex(fieldNode)]), 3);
            end
            else
            begin
              sl.AddIndent(Format('%s: %s;', [fname, MapXCBTypeToPascal(ftype)]), 3);
            end;
          end
          else if SameText(fieldNode.NodeName, 'pad') then
          begin
            // pad element: try to read bytes attr
            if Assigned(fieldNode.Attributes.GetNamedItem('bytes')) then
            begin
              try
                padBytes := StrToInt(fieldNode.Attributes.GetNamedItem('bytes').NodeValue);
                if padBytes > 0 then
                  sl.AddIndent(Format('pad_%d: array[0..%d-1] of cuint8; // padding', [NodeIndex(fieldNode), padBytes]), 3)
                else
                  sl.AddIndent(Format('pad_%d: cuint8; // pad (0 bytes)', [NodeIndex(fieldNode)]), 3);
              except
                on E: Exception do
                  sl.AddIndent(Format('pad_%d: cuint8; // pad (invalid bytes: %s)', [NodeIndex(fieldNode), fieldNode.Attributes.GetNamedItem('bytes').NodeValue]), 3);
              end;
            end
            else
              sl.AddIndent(Format('pad_%d: cuint8; // pad (unspecified bytes)', [NodeIndex(fieldNode)]), 3);
          end
          else if SameText(fieldNode.NodeName, 'doc') then
          begin
            // documentation node — ignore or optionally include as comment
            // sl.AddIndent('// doc: ' + Trim(fieldNode.TextContent), 3);
          end
          else
          begin
            // unknown/special nodes: list, switch, enumRef, etc. — add comment for manual handling
            sl.AddIndent(Format('// %s (node index %d) - manual handling may be required; original: %s', [fieldNode.NodeName, NodeIndex(fieldNode), Trim(fieldNode.TextContent)]), 3);
          end;
        end;

        sl.AddIndent('end;', 2);
        sl.Add('');
      end;

      child := child.NextSibling;
    end;
  finally
    processedStructs.Free;
  end;
end;

{ --- Process events/errors (as typedef of record) --- }
procedure ProcessEventsErrors(node: TDOMNode; sl: TStringList; kind: string);
var
  child, enode, fieldNode: TDOMNode;
  name, fname, ftype: string;
  i: Integer;
  processedItems: TStringList;
begin
  processedItems := TStringList.Create;
  try
    processedItems.Sorted := True;
    processedItems.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if SameText(child.NodeName, kind) then
      begin
        enode := child;
        name := enode.Attributes.GetNamedItem('name').NodeValue;
        
        // Skip if already processed
        if processedItems.IndexOf(name) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedItems.Add(name);
        
        sl.AddIndent('// ' + kind + ' ' + name, 1);
        sl.AddIndent('type', 1);
        sl.AddIndent(Format('%s = packed record', [SafeIdent('T' + name)]), 2);
        for i := 0 to enode.ChildNodes.Count - 1 do
        begin
          fieldNode := enode.ChildNodes[i];
          if fieldNode.NodeName = 'field' then
          begin
            fname := SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue);
            if fieldNode.Attributes.GetNamedItem('type') <> nil then
              ftype := fieldNode.Attributes.GetNamedItem('type').NodeValue
            else
              ftype := '';
            if (ftype = '') or SameText(ftype, 'str') or SameText(ftype, 'list') then
              sl.AddIndent(Format('%s: Pointer; // original: %s', [fname, fieldNode.TextContent]), 3)
            else
              sl.AddIndent(Format('%s: %s;', [fname, MapXCBTypeToPascal(ftype)]), 3);
          end;
        end;
        sl.AddIndent('end;', 2);
        sl.Add('');
      end;
      child := child.NextSibling;
    end;
  finally
    processedItems.Free;
  end;
end;

{ --- Process requests (generate opcode const and reply record if present) --- }
procedure ProcessRequests(node: TDOMNode; sl: TStringList);
var
  child, rnode, replyNode, fieldNode: TDOMNode;
  name, opcode: string;
  i, j: Integer;
  processedRequests: TStringList;
begin
  processedRequests := TStringList.Create;
  try
    processedRequests.Sorted := True;
    processedRequests.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if child.NodeName = 'request' then
      begin
        rnode := child;
        name := rnode.Attributes.GetNamedItem('name').NodeValue;
        
        // Skip if already processed
        if processedRequests.IndexOf(name) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedRequests.Add(name);
        
        opcode := '0'; // may be in attribute opcode
        if rnode.Attributes.GetNamedItem('opcode') <> nil then
          opcode := rnode.Attributes.GetNamedItem('opcode').NodeValue;
        sl.AddIndent('// request ' + name, 1);
        sl.AddIndent(Format('const XCB_%s = %s; // opcode', [UpperCase(name), opcode]), 1);
        // reply
        replyNode := nil;
        for i := 0 to rnode.ChildNodes.Count - 1 do
        begin
          if rnode.ChildNodes[i].NodeName = 'reply' then
          begin
            replyNode := rnode.ChildNodes[i];
            Break;
          end;
        end;
        if Assigned(replyNode) then
        begin
          sl.AddIndent('type', 1);
          sl.AddIndent(Format('%sReply = packed record', [SafeIdent('T' + name)]), 2);
          for j := 0 to replyNode.ChildNodes.Count - 1 do
          begin
            fieldNode := replyNode.ChildNodes[j];
            if fieldNode.NodeName = 'field' then
            begin
              if fieldNode.Attributes.GetNamedItem('type') <> nil then
                sl.AddIndent(Format('%s: %s;', [SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue),
                  MapXCBTypeToPascal(fieldNode.Attributes.GetNamedItem('type').NodeValue)]), 3)
              else
                sl.AddIndent(Format('%s: Pointer; // varlen/unknown', [SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue)]), 3);
            end;
          end;
          sl.AddIndent('end;', 2);
          sl.Add('');
        end;
      end;
      child := child.NextSibling;
    end;
  finally
    processedRequests.Free;
  end;
end;

{ --- Process xid types --- }
procedure ProcessXidTypes(node: TDOMNode; sl: TStringList);
var
  child: TDOMNode;
  name: string;
  processedXids: TStringList;
begin
  processedXids := TStringList.Create;
  try
    processedXids.Sorted := True;
    processedXids.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if child.NodeName = 'xidtype' then
      begin
        name := child.Attributes.GetNamedItem('name').NodeValue;
        
        // Skip if already processed
        if processedXids.IndexOf(name) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedXids.Add(name);
        
        sl.AddIndent('// xidtype ' + name, 1);
        sl.AddIndent(Format('type %s = cuint32;', [SafeIdent('T' + name)]), 1);
        sl.Add('');
      end;
      child := child.NextSibling;
    end;
  finally
    processedXids.Free;
  end;
end;

{ --- Process constants (value) --- }
procedure ProcessValues(node: TDOMNode; sl: TStringList);
var
  child, vnode: TDOMNode;
  name, val: string;
  processedValues: TStringList;
begin
  processedValues := TStringList.Create;
  try
    processedValues.Sorted := True;
    processedValues.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if child.NodeName = 'value' then
      begin
        vnode := child;
        name := SafeIdent(vnode.Attributes.GetNamedItem('name').NodeValue);
        
        // Skip if already processed
        if processedValues.IndexOf(name) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedValues.Add(name);
        
        if vnode.Attributes.GetNamedItem('value') <> nil then
          val := vnode.Attributes.GetNamedItem('value').NodeValue
        else
          val := vnode.TextContent;
          
        // Handle hex values
        if Pos('0x', val) = 1 then
          val := '$' + Copy(val, 3, MaxInt);
          
        sl.AddIndent(Format('const %s = %s;', [name, val]), 1);
      end;
      child := child.NextSibling;
    end;
    if (sl.Count > 0) and (sl[sl.Count-1] <> '') then sl.Add('');
  finally
    processedValues.Free;
  end;
end;

{ --- Process unions --- }
procedure ProcessUnions(node: TDOMNode; sl: TStringList);
var
  child, unionNode, fieldNode: TDOMNode;
  i: Integer;
  unionName, fname, ftype: string;
  processedUnions: TStringList;
begin
  processedUnions := TStringList.Create;
  try
    processedUnions.Sorted := True;
    processedUnions.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if SameText(child.NodeName, 'union') then
      begin
        unionNode := child;
        unionName := unionNode.Attributes.GetNamedItem('name').NodeValue;
        
        // Skip if already processed
        if processedUnions.IndexOf(unionName) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedUnions.Add(unionName);

        sl.AddIndent('// union ' + unionName, 1);
        sl.AddIndent('type', 1);
        sl.AddIndent(Format('%s = packed record', [SafeIdent('T' + unionName)]), 2);
        sl.AddIndent('case Integer of', 3);

        for i := 0 to unionNode.ChildNodes.Count - 1 do
        begin
          fieldNode := unionNode.ChildNodes[i];
          if SameText(fieldNode.NodeName, 'field') then
          begin
            fname := SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue);
            if fieldNode.Attributes.GetNamedItem('type') <> nil then
              ftype := MapXCBTypeToPascal(fieldNode.Attributes.GetNamedItem('type').NodeValue)
            else
              ftype := 'Pointer';

            sl.AddIndent(Format('%d: (%s: %s);', [i, fname, ftype]), 4);
          end;
        end;

        sl.AddIndent('end;', 2);
        sl.Add('');
      end;
      child := child.NextSibling;
    end;
  finally
    processedUnions.Free;
  end;
end;

{ --- Check if XML file is valid (not XSD schema) --- }
function IsValidXCBXML(const xmlPath: string): Boolean;
var
  doc: TXMLDocument;
  root: TDOMNode;
begin
  Result := False;
  if not FileExists(xmlPath) then Exit;
  
  try
    ReadXMLFile(doc, xmlPath);
    try
      root := doc.DocumentElement;
      if not Assigned(root) then Exit;
      
      // Check if it's a real XCB protocol file, not XSD schema
      if (root.NodeName = 'xcb') or (Pos('protocol', LowerCase(xmlPath)) > 0) then
        Result := True;
    finally
      doc.Free;
    end;
  except
    on E: Exception do
      Result := False;
  end;
end;

{ --- Main: parse a single xml file and emit .pas --- }
procedure ProcessXMLFile(const xmlPath: string; const outDir: string);
var
  doc: TXMLDocument;
  root: TDOMNode;
  unitName, outFile: string;
  sl: TStringList;
  xmlFilename: string;
begin
  // Skip XSD schema files and invalid XML
  if not IsValidXCBXML(xmlPath) then
  begin
    WriteLn('Skipping invalid or XSD file: ', xmlPath);
    Exit;
  end;
  
  WriteLn('Parsing ', xmlPath);
  try
    ReadXMLFile(doc, xmlPath);
  except
    on E: Exception do
    begin
      WriteLn('Error reading XML ', xmlPath, ': ', E.Message);
      Exit;
    end;
  end;
  
  root := doc.DocumentElement;
  if not Assigned(root) then
  begin
    WriteLn('No document element in ', xmlPath);
    doc.Free;
    Exit;
  end;
  
  if root.Attributes.GetNamedItem('name') <> nil then
    unitName := root.Attributes.GetNamedItem('name').NodeValue
  else
    unitName := ChangeFileExt(ExtractFileName(xmlPath), '');
    
  unitName := SafeIdent(LowerCase(unitName)); // use lower-case safe name
  outFile := IncludeTrailingPathDelimiter(outDir) + unitName + '.pas';

  sl := TStringList.Create;
  try
    EmitUnitHeader(sl, unitName);

    // Add short auto-generated comment
    sl.AddIndent('// Auto-generated from ' + ExtractFileName(xmlPath), 1);
    sl.AddIndent('// Pure 1:1 C binding skeleton for FreePascal (packed records, consts).', 1);
    sl.Add('');

    // process common nodes in logical order
    ProcessXidTypes(root, sl);
    ProcessTypedefs(root, sl);
    ProcessEnums(root, sl);
    ProcessValues(root, sl);
    ProcessStructs(root, sl);
    ProcessUnions(root, sl);
    ProcessEventsErrors(root, sl, 'event');
    ProcessEventsErrors(root, sl, 'error');
    ProcessRequests(root, sl);

    EmitUnitFooter(sl);

    sl.SaveToFile(outFile);
    WriteLn('Wrote ', outFile);
  finally
    sl.Free;
    doc.Free;
  end;
end;

{ --- Main program entry --- }
var
  i: Integer;
  srcDir, outDir: string;
  sr: TSearchRec;
  found: Integer;
begin
  if ParamCount < 1 then
  begin
    WriteLn('Usage: generate_xcb_bindings <path-to-xcb-proto-xml-dir> [outdir]');
    Halt(1);
  end;
  srcDir := ParamStr(1);
  if ParamCount >= 2 then outDir := ParamStr(2) else outDir := srcDir;

  if not DirectoryExists(srcDir) then
  begin
    WriteLn('Directory not found: ', srcDir);
    Halt(1);
  end;

  // Create output directory if it doesn't exist
  if not DirectoryExists(outDir) then
    CreateDir(outDir);

  // iterate xml files
  found := 0;
  if FindFirst(IncludeTrailingPathDelimiter(srcDir) + '*.xml', faAnyFile, sr) = 0 then
  begin
    repeat
      ProcessXMLFile(IncludeTrailingPathDelimiter(srcDir) + sr.Name, outDir);
      Inc(found);
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;

  if found = 0 then
    WriteLn('No .xml files found in ', srcDir)
  else
    WriteLn('Processed ', found, ' files.');
end.

unit xcb;

{$mode objfpc}{$H+}

interface

uses
  ctypes;

type
  // Basic XCB types
  Txcb_connection_t = Pointer;
  Txcb_window_t = cuint32;
  Txcb_pixmap_t = cuint32;
  Txcb_cursor_t = cuint32;
  Txcb_font_t = cuint32;
  Txcb_gcontext_t = cuint32;
  Txcb_colormap_t = cuint32;
  Txcb_atom_t = cuint32;
  Txcb_drawable_t = cuint32;
  Txcb_fontable_t = cuint32;
  Txcb_bool_t = cuint8;
  Txcb_char2b_t = packed record
    byte1: cuint8;
    byte2: cuint8;
  end;

  // Common types used across modules
  TTimestamp = cuint32;
  TRectangle = packed record
    x: cint16;
    y: cint16;
    width: cuint16;
    height: cuint16;
  end;
  PRectangle = ^TRectangle;

implementation

end.

program generate_xcb_bindings;

{$mode objfpc}{$H+}
uses
  Classes, SysUtils, DOM, XMLRead, StrUtils, Math;

const
  INDENT = '  ';

type
  TStringListHelper = class helper for TStringList
    procedure AddIndent(const s: string; level: Integer = 0);
  end;

function NodeIndex(N: TDOMNode): Integer;
var p: TDOMNode;
begin
  Result := 0;
  p := N.PreviousSibling;
  while Assigned(p) do
  begin
    Inc(Result);
    p := p.PreviousSibling;
  end;
end;

procedure TStringListHelper.AddIndent(const s: string; level: Integer = 0);
var
  i: Integer;
  pref: string;
begin
  pref := StringOfChar(' ', level * Length(INDENT));
  Add(pref + s);
end;

{ --- Evaluate simple expressions --- }
function EvaluateSimpleExpression(const expr: string): string;
var
  parts: TStringArray;
  i, val, shift: Integer;
begin
  Result := expr;
  
  // Handle bit shifts: "1<<0" -> "1"
  if Pos('1<<', expr) = 1 then
  begin
    val := 1;
    shift := StrToIntDef(Copy(expr, 4, MaxInt), 0);
    Result := IntToStr(val shl shift);
    Exit;
  end;
  
  // Handle hex values
  if Pos('0x', expr) = 1 then
  begin
    Result := '$' + Copy(expr, 3, MaxInt);
    Exit;
  end;
  
  // Handle simple additions: "X + Y"
  parts := expr.Split(['+']);
  if Length(parts) = 2 then
  begin
    val := StrToIntDef(Trim(parts[0]), 0) + StrToIntDef(Trim(parts[1]), 0);
    Result := IntToStr(val);
    Exit;
  end;
end;

{ --- Utility: map XCB types to ctypes --- }
function MapXCBTypeToPascal(const xtype: string): string;
var
  x: string;
begin
  x := Trim(xtype);
  // Normalize common XCB types
  if x = '' then Exit('Pointer');
  if SameText(x, 'CARD8') then Exit('cuint8');
  if SameText(x, 'CARD16') then Exit('cuint16');
  if SameText(x, 'CARD32') then Exit('cuint32');
  if SameText(x, 'CARD64') then Exit('cuint64');
  if SameText(x, 'INT8') then Exit('cint8');
  if SameText(x, 'INT16') then Exit('cint16');
  if SameText(x, 'INT32') then Exit('cint32');
  if SameText(x, 'INT64') then Exit('cint64');
  if SameText(x, 'BYTE') then Exit('cuint8');
  if SameText(x, 'BOOL') then Exit('cuint8');
  if SameText(x, 'void') then Exit('Pointer');
  if SameText(x, 'string') or SameText(x, 'str') or SameText(x, 'STRING') then Exit('PAnsiChar');
  if SameText(x, 'float') then Exit('cfloat');
  if SameText(x, 'double') then Exit('cdouble');
  if SameText(x, 'char') then Exit('cchar');
  if SameText(x, 'Timestamp') or SameText(x, 'TIMESTAMP') then Exit('cuint32');
  if SameText(x, 'KeyCode') or SameText(x, 'KEYCODE') then Exit('cuint8');
  if SameText(x, 'KeySym') or SameText(x, 'KEYSYM') then Exit('cuint32');
  
  // X IDs and core types often map to uint32 on 64-bit ABI for xcb (but we keep cuint32)
  if SameText(x, 'Window') or SameText(x, 'Drawable') or SameText(x, 'Atom') or SameText(x, 'Colormap')
    or SameText(x, 'Cursor') or SameText(x, 'VisualID') or SameText(x, 'Time') 
    or SameText(x, 'Pixmap') or SameText(x, 'Region') or SameText(x, 'Rectangle')
    or SameText(x, 'Fence') or SameText(x, 'Crtc') or SameText(x, 'Transform')
    or SameText(x, 'Barrier') or SameText(x, 'Sync') or SameText(x, 'GLX') 
    or SameText(x, 'Behavior') then Exit('cuint32');
  
  // Fallback: if starts with 'CARD' numeric -> cuint32 default
  if StartsText('CARD', UpperCase(x)) then Exit('cuint32');
  if StartsText('INT', UpperCase(x)) then Exit('cint32');

  // If it looks like a custom typedef / xidtype, emit T<Name>
  // sanitize name: replace non-alnum with underscore
  Result := 'T' + StringReplace(x, '.', '_', [rfReplaceAll]);
end;

{ --- Emit safe identifier from xml name --- }
function SafeIdent(const s: string): string;
var
  r: string;
  i: Integer;
  keywords: TStringList;
begin
  if s = '' then
  begin
    Result := 'unnamed';
    Exit;
  end;
  
  r := s;
  // replace non-alnum with underscore
  for i := 1 to Length(r) do
    if not (r[i] in ['0'..'9','A'..'Z','a'..'z','_']) then
      r[i] := '_';
  
  // cannot start with digit
  if (Length(r) > 0) and (r[1] in ['0'..'9']) then
    r := 'N' + r;
    
  // Check for Pascal keywords and prefix with underscore
  keywords := TStringList.Create;
  try
    keywords.CommaText := 'record,type,class,property,function,procedure,begin,end,if,then,else,while,do,for,repeat,until,case,of,var,const,array,set,file,program,unit,uses,interface,implementation,initialization,finalization,label,inline,object,constructor,destructor,inherited,packed,absolute,external,forward,mod,div,not,or,and,xor,shl,shr,asm';
    
    if keywords.IndexOf(LowerCase(r)) >= 0 then
      r := '_' + r;
  finally
    keywords.Free;
  end;
  
  Result := r;
end;

{ --- Write unit header --- }
procedure EmitUnitHeader(sl: TStringList; const unitName: string);
begin
  sl.Add('unit ' + unitName + ';');
  sl.Add('');
  sl.Add('{$mode objfpc}{$H+}');
  sl.Add('');
  sl.Add('interface');
  sl.Add('');
  sl.Add('uses');
  sl.AddIndent('ctypes, xcb;', 1);
  sl.Add('');
end;

{ --- Write unit footer --- }
procedure EmitUnitFooter(sl: TStringList);
begin
  sl.Add('');
  sl.Add('implementation');
  sl.Add('');
  sl.Add('end.');
end;

{ --- Parse enums --- }
procedure ProcessEnums(node: TDOMNode; sl: TStringList);
var
  child, enumNode: TDOMNode;
  enumName: string;
  j: Integer;
  valName, valValue: string;
  attr: TDOMNode;
  processedEnums: TStringList;
begin
  processedEnums := TStringList.Create;
  try
    processedEnums.Sorted := True;
    processedEnums.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if (child.NodeName = 'enum') then
      begin
        enumNode := child;
        attr := enumNode.Attributes.GetNamedItem('name');
        if attr<>nil then
          enumName := attr.NodeValue
        else
          enumName := 'unnamed_enum';

        // Skip if already processed (avoid duplicates)
        if processedEnums.IndexOf(enumName) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedEnums.Add(enumName);

        sl.AddIndent('// enum ' + enumName, 1);

        for j := 0 to enumNode.ChildNodes.Count - 1 do
        begin
          if enumNode.ChildNodes[j].NodeName = 'item' then
          begin
            valName := enumNode.ChildNodes[j].Attributes.GetNamedItem('name').NodeValue;

            attr := enumNode.ChildNodes[j].Attributes.GetNamedItem('value');
            if attr<>nil then
              valValue := attr.NodeValue
            else
            begin
              // Try to get value from child text content for bitcase enums
              attr := enumNode.ChildNodes[j].Attributes.GetNamedItem('bit');
              if attr <> nil then
                valValue := IntToStr(1 shl StrToInt(attr.NodeValue))
              else
                valValue := '0';
            end;

            // Handle expressions
            valValue := EvaluateSimpleExpression(valValue);

            sl.AddIndent(Format('const %s = %s;', [SafeIdent(enumName + '_' + valName), valValue]), 1);
          end;
        end;
        sl.Add('');
      end;
      child := child.NextSibling;
    end;
  finally
    processedEnums.Free;
  end;
end;

{ --- Process typedefs --- }
procedure ProcessTypedefs(node: TDOMNode; sl: TStringList);
var
  child: TDOMNode;
  name, toType: string;
  processedTypes: TStringList;
begin
  processedTypes := TStringList.Create;
  try
    processedTypes.Sorted := True;
    processedTypes.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if child.NodeName = 'typedef' then
      begin
        name := child.Attributes.GetNamedItem('newname').NodeValue;
        
        // Skip if already processed
        if processedTypes.IndexOf(name) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedTypes.Add(name);
        
        if child.Attributes.GetNamedItem('oldname') <> nil then
          toType := child.Attributes.GetNamedItem('oldname').NodeValue
        else if child.TextContent <> '' then
          toType := Trim(child.TextContent)
        else
          toType := '';
        sl.AddIndent('// typedef ' + name + ' -> ' + toType, 1);
        if toType <> '' then
          sl.AddIndent(Format('type %s = %s;', [SafeIdent('T' + name), MapXCBTypeToPascal(toType)]), 1)
        else
          sl.AddIndent(Format('type %s = Pointer; // typedef %s (unknown target)', [SafeIdent('T' + name), name]), 1);
        sl.Add('');
      end;
      child := child.NextSibling;
    end;
  finally
    processedTypes.Free;
  end;
end;

{ --- Process structs --- }
procedure ProcessStructs(node: TDOMNode; sl: TStringList);
var
  child, structNode, fieldNode: TDOMNode;
  i, padBytes: Integer;
  structName, fname, ftype: string;
  attrNode: TDOMNode;
  processedStructs: TStringList;
begin
  processedStructs := TStringList.Create;
  try
    processedStructs.Sorted := True;
    processedStructs.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if SameText(child.NodeName, 'struct') then
      begin
        structNode := child;
        attrNode := structNode.Attributes.GetNamedItem('name');
        if Assigned(attrNode) then
          structName := attrNode.NodeValue
        else
          structName := 'unnamed_struct';

        // Skip if already processed
        if processedStructs.IndexOf(structName) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedStructs.Add(structName);

        sl.AddIndent('// struct ' + structName, 1);
        sl.AddIndent('type', 1);
        sl.AddIndent(Format('%s = packed record', [SafeIdent('T' + structName)]), 2);

        for i := 0 to structNode.ChildNodes.Count - 1 do
        begin
          fieldNode := structNode.ChildNodes[i];

          if SameText(fieldNode.NodeName, 'field') then
          begin
            // field name
            if Assigned(fieldNode.Attributes.GetNamedItem('name')) then
              fname := SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue)
            else
              fname := Format('field_%d', [NodeIndex(fieldNode)]);

            // field type (may be absent for list/str)
            if Assigned(fieldNode.Attributes.GetNamedItem('type')) then
              ftype := fieldNode.Attributes.GetNamedItem('type').NodeValue
            else
              ftype := '';

            // Special case: field named "type" conflicts with Pascal keyword
            if fname = 'type' then
              fname := '_type';

            // handle common varlen/list/str as Pointer with comment
            if (ftype = '') or SameText(ftype, 'list') or SameText(ftype, 'str') or SameText(ftype, 'STRING') then
            begin
              sl.AddIndent(Format('%s: Pointer; // original: %s (node index %d)', [fname, Trim(fieldNode.TextContent), NodeIndex(fieldNode)]), 3);
            end
            else
            begin
              sl.AddIndent(Format('%s: %s;', [fname, MapXCBTypeToPascal(ftype)]), 3);
            end;
          end
          else if SameText(fieldNode.NodeName, 'pad') then
          begin
            // pad element: try to read bytes attr
            if Assigned(fieldNode.Attributes.GetNamedItem('bytes')) then
            begin
              try
                padBytes := StrToInt(fieldNode.Attributes.GetNamedItem('bytes').NodeValue);
                if padBytes > 0 then
                  sl.AddIndent(Format('pad_%d: array[0..%d-1] of cuint8; // padding', [NodeIndex(fieldNode), padBytes]), 3)
                else
                  sl.AddIndent(Format('pad_%d: cuint8; // pad (0 bytes)', [NodeIndex(fieldNode)]), 3);
              except
                on E: Exception do
                  sl.AddIndent(Format('pad_%d: cuint8; // pad (invalid bytes: %s)', [NodeIndex(fieldNode), fieldNode.Attributes.GetNamedItem('bytes').NodeValue]), 3);
              end;
            end
            else
              sl.AddIndent(Format('pad_%d: cuint8; // pad (unspecified bytes)', [NodeIndex(fieldNode)]), 3);
          end
          else if SameText(fieldNode.NodeName, 'doc') then
          begin
            // documentation node — ignore or optionally include as comment
            // sl.AddIndent('// doc: ' + Trim(fieldNode.TextContent), 3);
          end
          else if SameText(fieldNode.NodeName, 'list') then
          begin
            // list field - treat as pointer for now
            sl.AddIndent(Format('list_%d: Pointer; // list field', [NodeIndex(fieldNode)]), 3);
          end
          else
          begin
            // unknown/special nodes: list, switch, enumRef, etc. — add comment for manual handling
            sl.AddIndent(Format('// %s (node index %d) - manual handling may be required; original: %s', [fieldNode.NodeName, NodeIndex(fieldNode), Trim(fieldNode.TextContent)]), 3);
          end;
        end;

        sl.AddIndent('end;', 2);
        sl.Add('');
      end;

      child := child.NextSibling;
    end;
  finally
    processedStructs.Free;
  end;
end;

{ --- Process events/errors (as typedef of record) --- }
procedure ProcessEventsErrors(node: TDOMNode; sl: TStringList; kind: string);
var
  child, enode, fieldNode: TDOMNode;
  name, fname, ftype: string;
  i: Integer;
  processedItems: TStringList;
begin
  processedItems := TStringList.Create;
  try
    processedItems.Sorted := True;
    processedItems.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if SameText(child.NodeName, kind) then
      begin
        enode := child;
        name := enode.Attributes.GetNamedItem('name').NodeValue;
        
        // Skip if already processed
        if processedItems.IndexOf(name) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedItems.Add(name);
        
        sl.AddIndent('// ' + kind + ' ' + name, 1);
        sl.AddIndent('type', 1);
        sl.AddIndent(Format('%s = packed record', [SafeIdent('T' + name)]), 2);
        for i := 0 to enode.ChildNodes.Count - 1 do
        begin
          fieldNode := enode.ChildNodes[i];
          if fieldNode.NodeName = 'field' then
          begin
            fname := SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue);
            
            // Special case: field named "type"
            if fname = 'type' then
              fname := '_type';
              
            if fieldNode.Attributes.GetNamedItem('type') <> nil then
              ftype := fieldNode.Attributes.GetNamedItem('type').NodeValue
            else
              ftype := '';
            if (ftype = '') or SameText(ftype, 'str') or SameText(ftype, 'list') then
              sl.AddIndent(Format('%s: Pointer; // original: %s', [fname, fieldNode.TextContent]), 3)
            else
              sl.AddIndent(Format('%s: %s;', [fname, MapXCBTypeToPascal(ftype)]), 3);
          end;
        end;
        sl.AddIndent('end;', 2);
        sl.Add('');
      end;
      child := child.NextSibling;
    end;
  finally
    processedItems.Free;
  end;
end;

{ --- Process requests (generate opcode const and reply record if present) --- }
procedure ProcessRequests(node: TDOMNode; sl: TStringList);
var
  child, rnode, replyNode, fieldNode: TDOMNode;
  name, opcode: string;
  i, j: Integer;
  processedRequests: TStringList;
begin
  processedRequests := TStringList.Create;
  try
    processedRequests.Sorted := True;
    processedRequests.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if child.NodeName = 'request' then
      begin
        rnode := child;
        name := rnode.Attributes.GetNamedItem('name').NodeValue;
        
        // Skip if already processed
        if processedRequests.IndexOf(name) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedRequests.Add(name);
        
        opcode := '0'; // may be in attribute opcode
        if rnode.Attributes.GetNamedItem('opcode') <> nil then
          opcode := rnode.Attributes.GetNamedItem('opcode').NodeValue;
        sl.AddIndent('// request ' + name, 1);
        sl.AddIndent(Format('const XCB_%s = %s; // opcode', [UpperCase(name), opcode]), 1);
        // reply
        replyNode := nil;
        for i := 0 to rnode.ChildNodes.Count - 1 do
        begin
          if rnode.ChildNodes[i].NodeName = 'reply' then
          begin
            replyNode := rnode.ChildNodes[i];
            Break;
          end;
        end;
        if Assigned(replyNode) then
        begin
          sl.AddIndent('type', 1);
          sl.AddIndent(Format('%sReply = packed record', [SafeIdent('T' + name)]), 2);
          for j := 0 to replyNode.ChildNodes.Count - 1 do
          begin
            fieldNode := replyNode.ChildNodes[j];
            if fieldNode.NodeName = 'field' then
            begin
              if fieldNode.Attributes.GetNamedItem('type') <> nil then
                sl.AddIndent(Format('%s: %s;', [SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue),
                  MapXCBTypeToPascal(fieldNode.Attributes.GetNamedItem('type').NodeValue)]), 3)
              else
                sl.AddIndent(Format('%s: Pointer; // varlen/unknown', [SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue)]), 3);
            end;
          end;
          sl.AddIndent('end;', 2);
          sl.Add('');
        end;
      end;
      child := child.NextSibling;
    end;
  finally
    processedRequests.Free;
  end;
end;

{ --- Process xid types --- }
procedure ProcessXidTypes(node: TDOMNode; sl: TStringList);
var
  child: TDOMNode;
  name: string;
  processedXids: TStringList;
begin
  processedXids := TStringList.Create;
  try
    processedXids.Sorted := True;
    processedXids.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if child.NodeName = 'xidtype' then
      begin
        name := child.Attributes.GetNamedItem('name').NodeValue;
        
        // Skip if already processed
        if processedXids.IndexOf(name) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedXids.Add(name);
        
        sl.AddIndent('// xidtype ' + name, 1);
        sl.AddIndent(Format('type %s = cuint32;', [SafeIdent('T' + name)]), 1);
        sl.Add('');
      end;
      child := child.NextSibling;
    end;
  finally
    processedXids.Free;
  end;
end;

{ --- Process constants (value) --- }
procedure ProcessValues(node: TDOMNode; sl: TStringList);
var
  child, vnode: TDOMNode;
  name, val: string;
  processedValues: TStringList;
begin
  processedValues := TStringList.Create;
  try
    processedValues.Sorted := True;
    processedValues.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if child.NodeName = 'value' then
      begin
        vnode := child;
        name := SafeIdent(vnode.Attributes.GetNamedItem('name').NodeValue);
        
        // Skip if already processed
        if processedValues.IndexOf(name) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedValues.Add(name);
        
        if vnode.Attributes.GetNamedItem('value') <> nil then
          val := vnode.Attributes.GetNamedItem('value').NodeValue
        else
          val := vnode.TextContent;
          
        // Handle expressions and hex values
        val := EvaluateSimpleExpression(val);
          
        sl.AddIndent(Format('const %s = %s;', [name, val]), 1);
      end;
      child := child.NextSibling;
    end;
    if (sl.Count > 0) and (sl[sl.Count-1] <> '') then sl.Add('');
  finally
    processedValues.Free;
  end;
end;

{ --- Process unions --- }
procedure ProcessUnions(node: TDOMNode; sl: TStringList);
var
  child, unionNode, fieldNode: TDOMNode;
  i: Integer;
  unionName, fname, ftype: string;
  processedUnions: TStringList;
begin
  processedUnions := TStringList.Create;
  try
    processedUnions.Sorted := True;
    processedUnions.Duplicates := dupIgnore;
    
    child := node.FirstChild;
    while Assigned(child) do
    begin
      if SameText(child.NodeName, 'union') then
      begin
        unionNode := child;
        unionName := unionNode.Attributes.GetNamedItem('name').NodeValue;
        
        // Skip if already processed
        if processedUnions.IndexOf(unionName) >= 0 then
        begin
          child := child.NextSibling;
          Continue;
        end;
        processedUnions.Add(unionName);

        sl.AddIndent('// union ' + unionName, 1);
        sl.AddIndent('type', 1);
        sl.AddIndent(Format('%s = packed record', [SafeIdent('T' + unionName)]), 2);
        sl.AddIndent('case Integer of', 3);

        for i := 0 to unionNode.ChildNodes.Count - 1 do
        begin
          fieldNode := unionNode.ChildNodes[i];
          if SameText(fieldNode.NodeName, 'field') then
          begin
            fname := SafeIdent(fieldNode.Attributes.GetNamedItem('name').NodeValue);
            if fieldNode.Attributes.GetNamedItem('type') <> nil then
              ftype := MapXCBTypeToPascal(fieldNode.Attributes.GetNamedItem('type').NodeValue)
            else
              ftype := 'Pointer';

            sl.AddIndent(Format('%d: (%s: %s);', [i, fname, ftype]), 4);
          end;
        end;

        sl.AddIndent('end;', 2);
        sl.Add('');
      end;
      child := child.NextSibling;
    end;
  finally
    processedUnions.Free;
  end;
end;

{ --- Check if XML file is valid (not XSD schema) --- }
function IsValidXCBXML(const xmlPath: string): Boolean;
var
  doc: TXMLDocument;
  root: TDOMNode;
begin
  Result := False;
  if not FileExists(xmlPath) then Exit;
  
  try
    ReadXMLFile(doc, xmlPath);
    try
      root := doc.DocumentElement;
      if not Assigned(root) then Exit;
      
      // Check if it's a real XCB protocol file, not XSD schema
      if (root.NodeName = 'xcb') or (Pos('protocol', LowerCase(xmlPath)) > 0) then
        Result := True;
    finally
      doc.Free;
    end;
  except
    on E: Exception do
      Result := False;
  end;
end;

{ --- Main: parse a single xml file and emit .pas --- }
procedure ProcessXMLFile(const xmlPath: string; const outDir: string);
var
  doc: TXMLDocument;
  root: TDOMNode;
  unitName, outFile: string;
  sl: TStringList;
  xmlFilename: string;
begin
  // Skip XSD schema files and invalid XML
  if not IsValidXCBXML(xmlPath) then
  begin
    WriteLn('Skipping invalid or XSD file: ', xmlPath);
    Exit;
  end;
  
  WriteLn('Parsing ', xmlPath);
  try
    ReadXMLFile(doc, xmlPath);
  except
    on E: Exception do
    begin
      WriteLn('Error reading XML ', xmlPath, ': ', E.Message);
      Exit;
    end;
  end;
  
  root := doc.DocumentElement;
  if not Assigned(root) then
  begin
    WriteLn('No document element in ', xmlPath);
    doc.Free;
    Exit;
  end;
  
  if root.Attributes.GetNamedItem('name') <> nil then
    unitName := root.Attributes.GetNamedItem('name').NodeValue
  else
    unitName := ChangeFileExt(ExtractFileName(xmlPath), '');
    
  unitName := SafeIdent(LowerCase(unitName)); // use lower-case safe name
  
  // Special handling for record.xml -> _record.pas
  if unitName = 'record' then
    unitName := '_record';
    
  outFile := IncludeTrailingPathDelimiter(outDir) + unitName + '.pas';

  sl := TStringList.Create;
  try
    EmitUnitHeader(sl, unitName);

    // Add short auto-generated comment
    sl.AddIndent('// Auto-generated from ' + ExtractFileName(xmlPath), 1);
    sl.AddIndent('// Pure 1:1 C binding skeleton for FreePascal (packed records, consts).', 1);
    sl.Add('');

    // process common nodes in logical order
    ProcessXidTypes(root, sl);
    ProcessTypedefs(root, sl);
    ProcessEnums(root, sl);
    ProcessValues(root, sl);
    ProcessStructs(root, sl);
    ProcessUnions(root, sl);
    ProcessEventsErrors(root, sl, 'event');
    ProcessEventsErrors(root, sl, 'error');
    ProcessRequests(root, sl);

    EmitUnitFooter(sl);

    sl.SaveToFile(outFile);
    WriteLn('Wrote ', outFile);
  finally
    sl.Free;
    doc.Free;
  end;
end;

{ --- Main program entry --- }
var
  i: Integer;
  srcDir, outDir: string;
  sr: TSearchRec;
  found: Integer;
begin
  if ParamCount < 1 then
  begin
    WriteLn('Usage: generate_xcb_bindings <path-to-xcb-proto-xml-dir> [outdir]');
    Halt(1);
  end;
  srcDir := ParamStr(1);
  if ParamCount >= 2 then outDir := ParamStr(2) else outDir := srcDir;

  if not DirectoryExists(srcDir) then
  begin
    WriteLn('Directory not found: ', srcDir);
    Halt(1);
  end;

  // Create output directory if it doesn't exist
  if not DirectoryExists(outDir) then
    CreateDir(outDir);

  // iterate xml files
  found := 0;
  if FindFirst(IncludeTrailingPathDelimiter(srcDir) + '*.xml', faAnyFile, sr) = 0 then
  begin
    repeat
      ProcessXMLFile(IncludeTrailingPathDelimiter(srcDir) + sr.Name, outDir);
      Inc(found);
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;

  if found = 0 then
    WriteLn('No .xml files found in ', srcDir)
  else
    WriteLn('Processed ', found, ' files.');
end.